home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / generic / tclStringObj.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  17.1 KB  |  599 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclStringObj.c --
  3.  *
  4.  *    This file contains procedures that implement string operations
  5.  *    on Tcl objects.  To do this efficiently (i.e. to allow many
  6.  *    appends to be done to an object without constantly reallocating
  7.  *    the space for the string representation) we overallocate the
  8.  *    space for the string and use the internal representation to keep
  9.  *    track of the extra space.  Objects with this internal
  10.  *    representation are called "expandable string objects".
  11.  *
  12.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  13.  *
  14.  * See the file "license.terms" for information on usage and redistribution
  15.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16.  *
  17.  * SCCS: @(#) tclStringObj.c 1.30 97/07/24 18:53:30
  18.  */
  19.  
  20. #include "tclInt.h"
  21.  
  22. /*
  23.  * Prototypes for procedures defined later in this file:
  24.  */
  25.  
  26. static void        ConvertToStringType _ANSI_ARGS_((Tcl_Obj *objPtr));
  27. static void        DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
  28.                 Tcl_Obj *copyPtr));
  29. static int        SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
  30.                 Tcl_Obj *objPtr));
  31. static void        UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
  32.  
  33. /*
  34.  * The structure below defines the string Tcl object type by means of
  35.  * procedures that can be invoked by generic object code.
  36.  */
  37.  
  38. Tcl_ObjType tclStringType = {
  39.     "string",                /* name */
  40.     (Tcl_FreeInternalRepProc *) NULL,    /* freeIntRepProc */
  41.     DupStringInternalRep,        /* dupIntRepProc */
  42.     UpdateStringOfString,        /* updateStringProc */
  43.     SetStringFromAny            /* setFromAnyProc */
  44. };
  45.  
  46. /*
  47.  *----------------------------------------------------------------------
  48.  *
  49.  * Tcl_NewStringObj --
  50.  *
  51.  *    This procedure is normally called when not debugging: i.e., when
  52.  *    TCL_MEM_DEBUG is not defined. It creates a new string object and
  53.  *    initializes it from the byte pointer and length arguments.
  54.  *
  55.  *    When TCL_MEM_DEBUG is defined, this procedure just returns the
  56.  *    result of calling the debugging version Tcl_DbNewStringObj.
  57.  *
  58.  * Results:
  59.  *    A newly created string object is returned that has ref count zero.
  60.  *
  61.  * Side effects:
  62.  *    The new object's internal string representation will be set to a
  63.  *    copy of the length bytes starting at "bytes". If "length" is
  64.  *    negative, use bytes up to the first NULL byte; i.e., assume "bytes"
  65.  *    points to a C-style NULL-terminated string. The object's type is set
  66.  *    to NULL. An extra NULL is added to the end of the new object's byte
  67.  *    array.
  68.  *
  69.  *----------------------------------------------------------------------
  70.  */
  71.  
  72. #ifdef TCL_MEM_DEBUG
  73. #undef Tcl_NewStringObj
  74.  
  75. Tcl_Obj *
  76. Tcl_NewStringObj(bytes, length)
  77.     register char *bytes;    /* Points to the first of the length bytes
  78.                  * used to initialize the new object. */
  79.     register int length;    /* The number of bytes to copy from "bytes"
  80.                  * when initializing the new object. If 
  81.                  * negative, use bytes up to the first
  82.                  * NULL byte. */
  83. {
  84.     return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
  85. }
  86.  
  87. #else /* if not TCL_MEM_DEBUG */
  88.  
  89. Tcl_Obj *
  90. Tcl_NewStringObj(bytes, length)
  91.     register char *bytes;    /* Points to the first of the length bytes
  92.                  * used to initialize the new object. */
  93.     register int length;    /* The number of bytes to copy from "bytes"
  94.                  * when initializing the new object. If 
  95.                  * negative, use bytes up to the first
  96.                  * NULL byte. */
  97. {
  98.     register Tcl_Obj *objPtr;
  99.  
  100.     if (length < 0) {
  101.     length = bytes ? strlen(bytes) : 0 ;
  102.     }
  103.     TclNewObj(objPtr);
  104.     TclInitStringRep(objPtr, bytes, length);
  105.     return objPtr;
  106. }
  107. #endif /* TCL_MEM_DEBUG */
  108.  
  109. /*
  110.  *----------------------------------------------------------------------
  111.  *
  112.  * Tcl_DbNewStringObj --
  113.  *
  114.  *    This procedure is normally called when debugging: i.e., when
  115.  *    TCL_MEM_DEBUG is defined. It creates new string objects. It is the
  116.  *    same as the Tcl_NewStringObj procedure above except that it calls
  117.  *    Tcl_DbCkalloc directly with the file name and line number from its
  118.  *    caller. This simplifies debugging since then the checkmem command
  119.  *    will report the correct file name and line number when reporting
  120.  *    objects that haven't been freed.
  121.  *
  122.  *    When TCL_MEM_DEBUG is not defined, this procedure just returns the
  123.  *    result of calling Tcl_NewStringObj.
  124.  *
  125.  * Results:
  126.  *    A newly created string object is returned that has ref count zero.
  127.  *
  128.  * Side effects:
  129.  *    The new object's internal string representation will be set to a
  130.  *    copy of the length bytes starting at "bytes". If "length" is
  131.  *    negative, use bytes up to the first NULL byte; i.e., assume "bytes"
  132.  *    points to a C-style NULL-terminated string. The object's type is set
  133.  *    to NULL. An extra NULL is added to the end of the new object's byte
  134.  *    array.
  135.  *
  136.  *----------------------------------------------------------------------
  137.  */
  138.  
  139. #ifdef TCL_MEM_DEBUG
  140.  
  141. Tcl_Obj *
  142. Tcl_DbNewStringObj(bytes, length, file, line)
  143.     register char *bytes;    /* Points to the first of the length bytes
  144.                  * used to initialize the new object. */
  145.     register int length;    /* The number of bytes to copy from "bytes"
  146.                  * when initializing the new object. If 
  147.                  * negative, use bytes up to the first
  148.                  * NULL byte. */
  149.     char *file;            /* The name of the source file calling this
  150.                  * procedure; used for debugging. */
  151.     int line;            /* Line number in the source file; used
  152.                  * for debugging. */
  153. {
  154.     register Tcl_Obj *objPtr;
  155.  
  156.     if (length < 0) {
  157.     length = strlen(bytes);
  158.     }
  159.     TclDbNewObj(objPtr, file, line);
  160.     TclInitStringRep(objPtr, bytes, length);
  161.     return objPtr;
  162. }
  163.  
  164. #else /* if not TCL_MEM_DEBUG */
  165.  
  166. Tcl_Obj *
  167. Tcl_DbNewStringObj(bytes, length, file, line)
  168.     register char *bytes;    /* Points to the first of the length bytes
  169.                  * used to initialize the new object. */
  170.     register int length;    /* The number of bytes to copy from "bytes"
  171.                  * when initializing the new object. If 
  172.                  * negative, use bytes up to the first
  173.                  * NULL byte. */
  174.     char *file;            /* The name of the source file calling this
  175.                  * procedure; used for debugging. */
  176.     int line;            /* Line number in the source file; used
  177.                  * for debugging. */
  178. {
  179.     return Tcl_NewStringObj(bytes, length);
  180. }
  181. #endif /* TCL_MEM_DEBUG */
  182.  
  183. /*
  184.  *----------------------------------------------------------------------
  185.  *
  186.  * Tcl_SetStringObj --
  187.  *
  188.  *    Modify an object to hold a string that is a copy of the bytes
  189.  *    indicated by the byte pointer and length arguments. 
  190.  *
  191.  * Results:
  192.  *    None.
  193.  *
  194.  * Side effects:
  195.  *    The object's string representation will be set to a copy of
  196.  *    the "length" bytes starting at "bytes". If "length" is negative, use
  197.  *    bytes up to the first NULL byte; i.e., assume "bytes" points to a
  198.  *    C-style NULL-terminated string. The object's old string and internal
  199.  *    representations are freed and the object's type is set NULL.
  200.  *
  201.  *----------------------------------------------------------------------
  202.  */
  203.  
  204. void
  205. Tcl_SetStringObj(objPtr, bytes, length)
  206.     register Tcl_Obj *objPtr;    /* Object whose internal rep to init. */
  207.     char *bytes;        /* Points to the first of the length bytes
  208.                  * used to initialize the object. */
  209.     register int length;    /* The number of bytes to copy from "bytes"
  210.                  * when initializing the object. If 
  211.                  * negative, use bytes up to the first
  212.                  * NULL byte.*/
  213. {
  214.     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
  215.  
  216.     /*
  217.      * Free any old string rep, then set the string rep to a copy of
  218.      * the length bytes starting at "bytes".
  219.      */
  220.  
  221.     if (Tcl_IsShared(objPtr)) {
  222.     panic("Tcl_SetStringObj called with shared object");
  223.     }
  224.  
  225.     Tcl_InvalidateStringRep(objPtr);
  226.     if (length < 0) {
  227.     length = strlen(bytes);
  228.     }
  229.     TclInitStringRep(objPtr, bytes, length);
  230.         
  231.     /*
  232.      * Set the type to NULL and free any internal rep for the old type.
  233.      */
  234.  
  235.     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
  236.     oldTypePtr->freeIntRepProc(objPtr);
  237.     }
  238.     objPtr->typePtr = NULL;
  239. }
  240.  
  241. /*
  242.  *----------------------------------------------------------------------
  243.  *
  244.  * Tcl_SetObjLength --
  245.  *
  246.  *    This procedure changes the length of the string representation
  247.  *    of an object.
  248.  *
  249.  * Results:
  250.  *    None.
  251.  *
  252.  * Side effects:
  253.  *    If the size of objPtr's string representation is greater than
  254.  *    length, then it is reduced to length and a new terminating null
  255.  *    byte is stored in the strength.  If the length of the string
  256.  *    representation is greater than length, the storage space is
  257.  *    reallocated to the given length; a null byte is stored at the
  258.  *    end, but other bytes past the end of the original string
  259.  *    representation are undefined.  The object's internal
  260.  *    representation is changed to "expendable string".
  261.  *
  262.  *----------------------------------------------------------------------
  263.  */
  264.  
  265. void
  266. Tcl_SetObjLength(objPtr, length)
  267.     register Tcl_Obj *objPtr;    /* Pointer to object.  This object must
  268.                  * not currently be shared. */
  269.     register int length;    /* Number of bytes desired for string
  270.                  * representation of object, not including
  271.                  * terminating null byte. */
  272. {
  273.     char *new;
  274.  
  275.     if (Tcl_IsShared(objPtr)) {
  276.     panic("Tcl_SetObjLength called with shared object");
  277.     }
  278.     if (objPtr->typePtr != &tclStringType) {
  279.     ConvertToStringType(objPtr);
  280.     }
  281.     
  282.     if ((long)length > objPtr->internalRep.longValue) {
  283.     /*
  284.      * Not enough space in current string. Reallocate the string
  285.      * space and free the old string.
  286.      */
  287.  
  288.     new = (char *) ckalloc((unsigned) (length+1));
  289.     if (objPtr->bytes != NULL) {
  290.         memcpy((VOID *) new, (VOID *) objPtr->bytes,
  291.             (size_t) objPtr->length);
  292.         Tcl_InvalidateStringRep(objPtr);
  293.     }
  294.     objPtr->bytes = new;
  295.     objPtr->internalRep.longValue = (long) length;
  296.     }
  297.     objPtr->length = length;
  298.     if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
  299.     objPtr->bytes[length] = 0;
  300.     }
  301. }
  302.  
  303. /*
  304.  *----------------------------------------------------------------------
  305.  *
  306.  * Tcl_AppendToObj --
  307.  *
  308.  *    This procedure appends a sequence of bytes to an object.
  309.  *
  310.  * Results:
  311.  *    None.
  312.  *
  313.  * Side effects:
  314.  *    The bytes at *bytes are appended to the string representation
  315.  *    of objPtr.
  316.  *
  317.  *----------------------------------------------------------------------
  318.  */
  319.  
  320. void
  321. Tcl_AppendToObj(objPtr, bytes, length)
  322.     register Tcl_Obj *objPtr;    /* Points to the object to append to. */
  323.     char *bytes;        /* Points to the bytes to append to the
  324.                  * object. */
  325.     register int length;    /* The number of bytes to append from
  326.                  * "bytes". If < 0, then append all bytes
  327.                  * up to NULL byte. */
  328. {
  329.     int newLength, oldLength;
  330.  
  331.     if (Tcl_IsShared(objPtr)) {
  332.     panic("Tcl_AppendToObj called with shared object");
  333.     }
  334.     if (objPtr->typePtr != &tclStringType) {
  335.     ConvertToStringType(objPtr);
  336.     }
  337.     if (length < 0) {
  338.     length = strlen(bytes);
  339.     }
  340.     if (length == 0) {
  341.     return;
  342.     }
  343.     oldLength = objPtr->length;
  344.     newLength = length + oldLength;
  345.     if ((long)newLength > objPtr->internalRep.longValue) {
  346.     /*
  347.      * There isn't currently enough space in the string
  348.      * representation so allocate additional space.  In fact,
  349.      * overallocate so that there is room for future growth without
  350.      * having to reallocate again.
  351.      */
  352.  
  353.     Tcl_SetObjLength(objPtr, 2*newLength);
  354.     }
  355.     if (length > 0) {
  356.     memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
  357.            (size_t) length);
  358.     objPtr->length = newLength;
  359.     objPtr->bytes[objPtr->length] = 0;
  360.     }
  361. }
  362.  
  363. /*
  364.  *----------------------------------------------------------------------
  365.  *
  366.  * Tcl_AppendStringsToObj --
  367.  *
  368.  *    This procedure appends one or more null-terminated strings
  369.  *    to an object.
  370.  *
  371.  * Results:
  372.  *    None.
  373.  *
  374.  * Side effects:
  375.  *    The contents of all the string arguments are appended to the
  376.  *    string representation of objPtr.
  377.  *
  378.  *----------------------------------------------------------------------
  379.  */
  380.  
  381. void
  382. Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
  383. {
  384.     va_list argList;
  385.     register Tcl_Obj *objPtr;
  386.     int newLength, oldLength;
  387.     register char *string, *dst;
  388.  
  389.     objPtr = (Tcl_Obj *) TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
  390.     if (Tcl_IsShared(objPtr)) {
  391.     panic("Tcl_AppendStringsToObj called with shared object");
  392.     }
  393.     if (objPtr->typePtr != &tclStringType) {
  394.     ConvertToStringType(objPtr);
  395.     }
  396.  
  397.     /*
  398.      * Figure out how much space is needed for all the strings, and
  399.      * expand the string representation if it isn't big enough. If no
  400.      * bytes would be appended, just return.
  401.      */
  402.  
  403.     newLength = oldLength = objPtr->length;
  404.     while (1) {
  405.     string = va_arg(argList, char *);
  406.     if (string == NULL) {
  407.         break;
  408.     }
  409.     newLength += strlen(string);
  410.     }
  411.     if (newLength == oldLength) {
  412.     return;
  413.     }
  414.  
  415.     if ((long)newLength > objPtr->internalRep.longValue) {
  416.     /*
  417.      * There isn't currently enough space in the string
  418.      * representation so allocate additional space.  If the current
  419.      * string representation isn't empty (i.e. it looks like we're
  420.      * doing a series of appends) then overallocate the space so
  421.      * that we won't have to do as much reallocation in the future.
  422.      */
  423.  
  424.     Tcl_SetObjLength(objPtr,
  425.         (objPtr->length == 0) ? newLength : 2*newLength);
  426.     }
  427.  
  428.     /*
  429.      * Make a second pass through the arguments, appending all the
  430.      * strings to the object.
  431.      */
  432.  
  433.     TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
  434.     dst = objPtr->bytes + oldLength;
  435.     while (1) {
  436.     string = va_arg(argList, char *);
  437.     if (string == NULL) {
  438.         break;
  439.     }
  440.     while (*string != 0) {
  441.         *dst = *string;
  442.         dst++;
  443.         string++;
  444.     }
  445.     }
  446.  
  447.     /*
  448.      * Add a null byte to terminate the string.  However, be careful:
  449.      * it's possible that the object is totally empty (if it was empty
  450.      * originally and there was nothing to append).  In this case dst is
  451.      * NULL; just leave everything alone.
  452.      */
  453.  
  454.     if (dst != NULL) {
  455.     *dst = 0;
  456.     }
  457.     objPtr->length = newLength;
  458.     va_end(argList);
  459. }
  460.  
  461. /*
  462.  *----------------------------------------------------------------------
  463.  *
  464.  * ConvertToStringType --
  465.  *
  466.  *    This procedure converts the internal representation of an object
  467.  *    to "expandable string" type.
  468.  *
  469.  * Results:
  470.  *    None.
  471.  *
  472.  * Side effects:
  473.  *    Any old internal reputation for objPtr is freed and the
  474.  *    internal representation is set to that for an expandable string
  475.  *    (the field internalRep.longValue holds 1 less than the allocated
  476.  *    length of objPtr's string representation).
  477.  *
  478.  *----------------------------------------------------------------------
  479.  */
  480.  
  481. static void
  482. ConvertToStringType(objPtr)
  483.     register Tcl_Obj *objPtr;    /* Pointer to object.  Must have a
  484.                  * typePtr that isn't &tclStringType. */
  485. {
  486.     if (objPtr->typePtr != NULL) {
  487.     if (objPtr->bytes == NULL) {
  488.         objPtr->typePtr->updateStringProc(objPtr);
  489.     }
  490.     if (objPtr->typePtr->freeIntRepProc != NULL) {
  491.         objPtr->typePtr->freeIntRepProc(objPtr);
  492.     }
  493.     }
  494.     objPtr->typePtr = &tclStringType;
  495.     if (objPtr->bytes != NULL) {
  496.     objPtr->internalRep.longValue = (long)objPtr->length;
  497.     } else {
  498.     objPtr->internalRep.longValue = 0;
  499.     objPtr->length = 0;
  500.     }
  501. }
  502.  
  503. /*
  504.  *----------------------------------------------------------------------
  505.  *
  506.  * DupStringInternalRep --
  507.  *
  508.  *    Initialize the internal representation of a new Tcl_Obj to a
  509.  *    copy of the internal representation of an existing string object.
  510.  *
  511.  * Results:
  512.  *    None.
  513.  *
  514.  * Side effects:
  515.  *    copyPtr's internal rep is set to a copy of srcPtr's internal
  516.  *    representation.
  517.  *
  518.  *----------------------------------------------------------------------
  519.  */
  520.  
  521. static void
  522. DupStringInternalRep(srcPtr, copyPtr)
  523.     register Tcl_Obj *srcPtr;    /* Object with internal rep to copy.  Must
  524.                  * have an internal representation of type
  525.                  * "expandable string". */
  526.     register Tcl_Obj *copyPtr;    /* Object with internal rep to set.  Must
  527.                  * not currently have an internal rep.*/
  528. {
  529.     /*
  530.      * Tricky point: the string value was copied by generic object
  531.      * management code, so it doesn't contain any extra bytes that
  532.      * might exist in the source object.
  533.      */
  534.  
  535.     copyPtr->internalRep.longValue = (long)copyPtr->length;
  536.     copyPtr->typePtr = &tclStringType;
  537. }
  538.  
  539. /*
  540.  *----------------------------------------------------------------------
  541.  *
  542.  * SetStringFromAny --
  543.  *
  544.  *    Create an internal representation of type "expandable string"
  545.  *    for an object.
  546.  *
  547.  * Results:
  548.  *    This operation always succeeds and returns TCL_OK.
  549.  *
  550.  * Side effects:
  551.  *    This procedure does nothing; there is no advantage in converting
  552.  *    the internal representation now, so we just defer it.
  553.  *
  554.  *----------------------------------------------------------------------
  555.  */
  556.  
  557. static int
  558. SetStringFromAny(interp, objPtr)
  559.     Tcl_Interp *interp;        /* Used for error reporting if not NULL. */
  560.     Tcl_Obj *objPtr;        /* The object to convert. */
  561. {
  562.     return TCL_OK;
  563. }
  564.  
  565. /*
  566.  *----------------------------------------------------------------------
  567.  *
  568.  * UpdateStringOfString --
  569.  *
  570.  *    Update the string representation for an object whose internal
  571.  *    representation is "expandable string".
  572.  *
  573.  * Results:
  574.  *    None.
  575.  *
  576.  * Side effects:
  577.  *    None.
  578.  *
  579.  *----------------------------------------------------------------------
  580.  */
  581.  
  582. static void
  583. UpdateStringOfString(objPtr)
  584.     Tcl_Obj *objPtr;        /* Object with string rep to update. */
  585. {
  586.     /*
  587.      * The string is almost always valid already, in which case there's
  588.      * nothing for us to do. The only case we have to worry about is if
  589.      * the object is totally null. In this case, set the string rep to
  590.      * an empty string.
  591.      */
  592.  
  593.     if (objPtr->bytes == NULL) {
  594.     objPtr->bytes = tclEmptyStringRep;
  595.     objPtr->length = 0;
  596.     }
  597.     return;
  598. }
  599.